***                                                                                                                                                                                                                                                       
***                                                                                                                                                                                                                                                       
*** This Program already converted to Y2K                                                                                                                                                                                                                 
*** S&T Departement     on 29 April 1999 by Ben.Rahman                                                                                                                                                                                                    
***                                                                                                                                                                                                                                                       
***                                                                                                                                                                                                                                                       
set cent on                                                                                                                                                                                                                                               
F1='DLV_PHAR'                                                                                                                                                                                                                                             
F11='DLVPHADO'                                                                                                                                                                                                                                            
F2='DRUGS'                                                                                                                                                                                                                                                
F3='DISPOS'                                                                                                                                                                                                                                               
SET EXCLU OFF                                                                                                                                                                                                                                             
USE &DR&F1                                                                                                                                                                                                                                                
*INDEX ON COMP_CODE+delv_order TO &DR&F11                                                                                                                                                                                                                 
USE                                                                                                                                                                                                                                                       
F1='DLV_PHAR'                                                                                                                                                                                                                                             
*F2='DLV_TEMP'                                                                                                                                                                                                                                            
SELE 1                                                                                                                                                                                                                                                    
SET EXCLU OFF                                                                                                                                                                                                                                             
USE &DR&F1 INDEX &DR&F11                                                                                                                                                                                                                                  
SELE 2                                                                                                                                                                                                                                                    
SET EXCLU OFF                                                                                                                                                                                                                                             
USE &DR&F2 INDE &DR&F2                                                                                                                                                                                                                                    
SELE 3                                                                                                                                                                                                                                                    
SET EXCLU OFF                                                                                                                                                                                                                                             
USE &DR&F3 INDE &DR&F3                                                                                                                                                                                                                                    
DO WHILE .T.                                                                                                                                                                                                                                              
   DO ADDRDOR1                                                                                                                                                                                                                                            
   @  8, 5 SAY "PRINT"                                                                                                                                                                                                                                    
                                                                                                                                                                                                                                                          
   COMPCOD=SPACE(4)                                                                                                                                                                                                                                       
   set colo to bg+/b,w+/n                                                                                                                                                                                                                                 
   @ 7,1 clear to 23,78                                                                                                                                                                                                                                   
   CNT=0                                                                                                                                                                                                                                                  
   KODE=SPACE(4)                                                                                                                                                                                                                                          
   kunci=space(4)                                                                                                                                                                                                                                         
   do boxe with 11,3,'Enter Initial of Client Code : ','KUNCI','N','BG','W+','N',4,.T.,.T.                                                                                                                                                                
   if lastkey()=27                                                                                                                                                                                                                                        
      set colo to bg+/b,w+/n                                                                                                                                                                                                                              
      return                                                                                                                                                                                                                                              
   endif                                                                                                                                                                                                                                                  
                                                                                                                                                                                                                                                          
   do getcompc                                                                                                                                                                                                                                            
   if lastkey()=27                                                                                                                                                                                                                                        
      return                                                                                                                                                                                                                                              
   endif                                                                                                                                                                                                                                                  
   SET COLO TO BG+/B,W+/N                                                                                                                                                                                                                                 
   @ 7,1 CLEAR TO 23,78                                                                                                                                                                                                                                   
   SET INDE TO &DR&F11                                                                                                                                                                                                                                    
   SEEK COMPCOD                                                                                                                                                                                                                                           
   IF EOF()                                                                                                                                                                                                                                               
      @ 12, 48  SAY "THIS CODE DOES NOT CORRESPOND"                                                                                                                                                                                                       
      @ 13, 48  SAY ">>   TO A LISTED COMPANY   <<"                                                                                                                                                                                                       
      @ 14, 48  SAY ">>   PLEASE ENTER AGAIN  ! <<"                                                                                                                                                                                                       
      STORE 0 TO MX                                                                                                                                                                                                                                       
      DO WHILE MX=0                                                                                                                                                                                                                                       
         MX=INKEY()                                                                                                                                                                                                                                       
      ENDDO                                                                                                                                                                                                                                               
      DO CASE                                                                                                                                                                                                                                             
         CASE MX=13                                                                                                                                                                                                                                       
          LOOP                                                                                                                                                                                                                                            
      ENDCASE                                                                                                                                                                                                                                             
      LOOP                                                                                                                                                                                                                                                
   ELSE                                                                                                                                                                                                                                                   
      NOR=RECNO()                                                                                                                                                                                                                                         
      EXIT                                                                                                                                                                                                                                                
   ENDIF                                                                                                                                                                                                                                                  
ENDDO                                                                                                                                                                                                                                                     
                                                                                                                                                                                                                                                          
COMPNAME=CLIENT                                                                                                                                                                                                                                           
@ 9,3 SAY 'CLIENT NAME : '+COMPNAME                                                                                                                                                                                                                       
                                                                                                                                                                                                                                                          
                                                                                                                                                                                                                                                          
CNT=0                                                                                                                                                                                                                                                     
SELE 1                                                                                                                                                                                                                                                    
GOTO NOR                                                                                                                                                                                                                                                  
DO WHILE .NOT. EOF()                                                                                                                                                                                                                                      
   IF COMP_CODE<>COMPCOD                                                                                                                                                                                                                                  
      SKIP                                                                                                                                                                                                                                                
      LOOP                                                                                                                                                                                                                                                
   ENDIF                                                                                                                                                                                                                                                  
   IF DELV_PRINT                                                                                                                                                                                                                                          
      SKIP                                                                                                                                                                                                                                                
      LOOP                                                                                                                                                                                                                                                
   ENDIF                                                                                                                                                                                                                                                  
   CNT=CNT+1                                                                                                                                                                                                                                              
   NUMDO=delv_order                                                                                                                                                                                                                                       
   DO WHILE delv_order=NUMDO .AND. .NOT. EOF()                                                                                                                                                                                                            
      SKIP                                                                                                                                                                                                                                                
   ENDDO                                                                                                                                                                                                                                                  
   SELE 1                                                                                                                                                                                                                                                 
ENDDO                                                                                                                                                                                                                                                     
if cnt=0                                                                                                                                                                                                                                                  
  DO WHILE .T.                                                                                                                                                                                                                                            
   @ 11,3 clea to 23,77                                                                                                                                                                                                                                   
   @ 12, 18  SAY ">>>>> ALL DELIVERIES FOR THIS COMPANY <<<<<"                                                                                                                                                                                            
   @ 13, 18  SAY ">>>>>>>>>>>>> ALREADY PRINTED <<<<<<<<<<<<<"                                                                                                                                                                                            
   @ 14, 18  SAY ">>>>>>>>>> PLEASE ENTER AGAIN  ! <<<<<<<<<<"                                                                                                                                                                                            
   STORE 0 TO MX                                                                                                                                                                                                                                          
   DO WHILE MX=0                                                                                                                                                                                                                                          
      MX=INKEY()                                                                                                                                                                                                                                          
   ENDDO                                                                                                                                                                                                                                                  
   DO CASE                                                                                                                                                                                                                                                
      CASE MX=13                                                                                                                                                                                                                                          
        set exclu off                                                                                                                                                                                                                                     
        close data                                                                                                                                                                                                                                        
        close index                                                                                                                                                                                                                                       
        return                                                                                                                                                                                                                                            
   ENDCASE                                                                                                                                                                                                                                                
  ENDDO                                                                                                                                                                                                                                                   
endif                                                                                                                                                                                                                                                     
DECLARE FIL1[CNT]                                                                                                                                                                                                                                         
DECLARE FIL2[CNT]                                                                                                                                                                                                                                         
CR=0                                                                                                                                                                                                                                                      
SELE 1                                                                                                                                                                                                                                                    
GOTO NOR                                                                                                                                                                                                                                                  
DO WHILE .NOT. EOF()                                                                                                                                                                                                                                      
   IF COMP_CODE<>COMPCOD                                                                                                                                                                                                                                  
      SKIP                                                                                                                                                                                                                                                
      LOOP                                                                                                                                                                                                                                                
   ENDIF                                                                                                                                                                                                                                                  
   IF DELV_PRINT                                                                                                                                                                                                                                          
      SKIP                                                                                                                                                                                                                                                
      LOOP                                                                                                                                                                                                                                                
   ENDIF                                                                                                                                                                                                                                                  
   CR=CR+1                                                                                                                                                                                                                                                
   FIL1[CR]=SUBSTR(DELV_ORDER,7,4)+'     '+DTOC(DATE_DELV)+'   '+PO_NUMB_CL                                                                                                                                                                               
   FIL2[CR]=DELV_ORDER                                                                                                                                                                                                                                    
   NUMDO=delv_order                                                                                                                                                                                                                                       
   DO WHILE delv_order=NUMDO .AND. .NOT. EOF()                                                                                                                                                                                                            
      SKIP                                                                                                                                                                                                                                                
   ENDDO                                                                                                                                                                                                                                                  
   SELE 1                                                                                                                                                                                                                                                 
ENDDO                                                                                                                                                                                                                                                     
DO WHILE .T.                                                                                                                                                                                                                                              
   @ 11,  3  TO 23, 47    DOUBLE                                                                                                                                                                                                                          
   @ 12, 5 SAY 'D.O. #   DATE       P.O. #'                                                                                                                                                                                                               
   @ 13, 4 TO 13,46                                                                                                                                                                                                                                       
   inkey()                                                                                                                                                                                                                                                
   cari=achoice(14,5,22,46,fil1)                                                                                                                                                                                                                          
   mix=lastkey()                                                                                                                                                                                                                                          
   DO CASE                                                                                                                                                                                                                                                
      CASE MIX=13                                                                                                                                                                                                                                         
        DONUM=FIL2[CARI]                                                                                                                                                                                                                                  
        EXIT                                                                                                                                                                                                                                              
      CASE MIX=27                                                                                                                                                                                                                                         
        SET EXCLU OFF                                                                                                                                                                                                                                     
        CLOSE DATA                                                                                                                                                                                                                                        
        CLOSE INDEX                                                                                                                                                                                                                                       
        RETURN                                                                                                                                                                                                                                            
   ENDCASE                                                                                                                                                                                                                                                
ENDDO                                                                                                                                                                                                                                                     
DO ADDRESSA                                                                                                                                                                                                                                               
@  8,  5  SAY "F. DELIVERY TO CLIENTS              D.O. NUMBER :"                                                                                                                                                                                         
@ 10,  5  SAY "CLIENT :"                                                                                                                                                                                                                                  
@  8, 55  SAY DONUM                                                                                                                                                                                                                                       
@ 10, 14  SAY COMPNAME                                                                                                                                                                                                                                    
@ 10, 71  SAY COMPCOD                                                                                                                                                                                                                                     
@  9,  3  TO 11, 76    DOUBLE                                                                                                                                                                                                                             
@ 12,  1 CLEAR TO 23, 78                                                                                                                                                                                                                                  
**********                                                                                                                                                                                                                                                
*@ 15,3 clea to 23,77                                                                                                                                                                                                                                     
KLR='N'                                                                                                                                                                                                                                                   
DO SET_DEV                                                                                                                                                                                                                                                
IF KLR='Y'                                                                                                                                                                                                                                                
   CLOSE DATA                                                                                                                                                                                                                                             
   CLOSE INDEX                                                                                                                                                                                                                                            
   RETURN                                                                                                                                                                                                                                                 
ENDIF                                                                                                                                                                                                                                                     
br=100                                                                                                                                                                                                                                                    
fl=0                                                                                                                                                                                                                                                      
hl=0                                                                                                                                                                                                                                                      
ttl=0                                                                                                                                                                                                                                                     
store 0 to ttl1,ttl2,ttl3,ttl4,ttl5,sw,sw1,sw2,sw3                                                                                                                                                                                                        
set devi to print                                                                                                                                                                                                                                         
@ 0,0 SAY CHR(18) PICT 'X'                                                                                                                                                                                                                                
@ 0,0 say chr(27)+CHR(77)                                                                                                                                                                                                                                 
SELE 1                                                                                                                                                                                                                                                    
SEEK COMPCOD+DONUM                                                                                                                                                                                                                                        
IF .NOT. EOF()                                                                                                                                                                                                                                            
   do while  delv_order=DONUM .AND. .not. eof()                                                                                                                                                                                                           
      PONUM=PO_NUMB_CL                                                                                                                                                                                                                                    
      if br>46                                                                                                                                                                                                                                            
         IF SW>0                                                                                                                                                                                                                                          
            @ 52,50 SAY 'TO CARRY FORWARD TO PAGE #'+LTRIM(STR(HL+1,2))+' :'                                                                                                                                                                              
            @ 52,81 SAY TTL1 PICT '99,999,999,999'                                                                                                                                                                                                        
         ENDIF                                                                                                                                                                                                                                            
         if fl>0                                                                                                                                                                                                                                          
            eject                                                                                                                                                                                                                                         
         else                                                                                                                                                                                                                                             
            fl=1                                                                                                                                                                                                                                          
         endif                                                                                                                                                                                                                                            
         cl=50                                                                                                                                                                                                                                            
         hl=hl+1                                                                                                                                                                                                                                          
         @  0, 00 SAY 'AEA INTERNATIONAL CLINIC - SITE'                                                                                                                                                                                                   
         @  0, 80 SAY 'DATE : '+DTOC(DATE())                                                                                                                                                                                                              
         @  1, 00 SAY AEANAME                                                                                                                                                                                                                             
         @  5, 23 say CHR(14)+'D E L I V E R Y   O R D E R'                                                                                                                                                                                               
         @  6, 23 SAY CHR(14)+'---------------------------'                                                                                                                                                                                               
         STRTHN=SUBS(DTOC(DATE()),7,4)                                                                                                                                                                                                                    
         IF MONTH(DATE())<10                                                                                                                                                                                                                              
            STRBLN='0'+LTRIM(STR(MONTH(DATE()),2))                                                                                                                                                                                                        
         ELSE                                                                                                                                                                                                                                             
            STRBLN=STR(MONTH(DATE()),2)                                                                                                                                                                                                                   
         ENDIF                                                                                                                                                                                                                                            
         JDL="ORDER # : "+DONUM                                                                                                                                                                                                                           
         @ 7,3+INT((93-LEN(JDL))/2) SAY JDL                                                                                                                                                                                                               
         @  8, 00 SAY 'P.O. #      : '+PONUM                                                                                                                                                                                                              
         @  8, 83 say 'PAGE # : '                                                                                                                                                                                                                         
         @  8, 92 say hl pict '999'                                                                                                                                                                                                                       
         @  9, 00 SAY 'CLIENT CODE : '+COMPCOD                                                                                                                                                                                                            
         @ 10, 00 SAY 'CLIENT NAME : '+COMPNAME                                                                                                                                                                                                           
         SELE 1                                                                                                                                                                                                                                           
         @ 11,  0 say repl('=',95)                                                                                                                                                                                                                        
         @ 12,  0 say 'CODE'                                                                                                                                                                                                                              
         @ 12,  7 SAY 'NAME'                                                                                                                                                                                                                              
         @ 12, 29 SAY 'TYPE'                                                                                                                                                                                                                              
         @ 12, 43 SAY 'CONTENT'                                                                                                                                                                                                                           
         @ 12, 52 SAY 'UNIT'                                                                                                                                                                                                                              
         @ 12, 58 say 'UNIT PRICE'                                                                                                                                                                                                                        
         @ 12, 70 say ' QUANTITY'                                                                                                                                                                                                                         
         @ 12, 82 say '  TOTAL VALUE'                                                                                                                                                                                                                     
         @ 13,0 say repl('-',95)                                                                                                                                                                                                                          
         br=13                                                                                                                                                                                                                                            
         IF SW>0                                                                                                                                                                                                                                          
            BR=BR+1                                                                                                                                                                                                                                       
            @ BR,49 SAY 'CARRIED FORWARD FROM PAGE #'+LTRIM(STR(HL-1,2))+' :'                                                                                                                                                                             
            @ BR,81 SAY TTL1 PICT '99,999,999,999'                                                                                                                                                                                                        
         ENDIF                                                                                                                                                                                                                                            
         SW=1                                                                                                                                                                                                                                             
      endif                                                                                                                                                                                                                                               
      br=br+1                                                                                                                                                                                                                                             
      IF REC_LOCK(0)                                                                                                                                                                                                                                      
         REPL DELV_PRINT WITH .T.                                                                                                                                                                                                                         
         REPL DELV_ORDER WITH DONUM                                                                                                                                                                                                                       
         REPL PRINT_DATE WITH DATE()                                                                                                                                                                                                                      
      ENDIF                                                                                                                                                                                                                                               
      UNLOCK                                                                                                                                                                                                                                              
      @ BR,  0 SAY PHAR_CODE                                                                                                                                                                                                                              
      @ BR,  7 SAY PHAR_NAME                                                                                                                                                                                                                              
      @ BR, 29 SAY PHAR_TYPE                                                                                                                                                                                                                              
      @ BR, 43 SAY PHAR_QANT                                                                                                                                                                                                                              
      @ BR, 52 SAY PHAR_UNIT                                                                                                                                                                                                                              
      @ BR, 58 SAY TRANS_PRIC PICT '99,999,999'                                                                                                                                                                                                           
      @ BR, 70 SAY QANT_DELV  PICT '9,999,999'                                                                                                                                                                                                            
      @ BR, 82 SAY VAL_DELV   PICT '9,999,999,999'                                                                                                                                                                                                        
      TTL1=TTL1+VAL_DELV                                                                                                                                                                                                                                  
      PHCD=PHAR_CODE                                                                                                                                                                                                                                      
      qty =qant_delv                                                                                                                                                                                                                                      
      SELE 2                                                                                                                                                                                                                                              
      SEEK PHCD                                                                                                                                                                                                                                           
      IF EOF()                                                                                                                                                                                                                                            
         SELE 3                                                                                                                                                                                                                                           
         SEEK PHCD                                                                                                                                                                                                                                        
      ENDIF                                                                                                                                                                                                                                               
      IF REC_LOCK()                                                                                                                                                                                                                                       
         repl st_act_tot with st_act_tot-qty                                                                                                                                                                                                              
         repl st_allocat with st_allocat-qty                                                                                                                                                                                                              
         REPL ST_ACT_BUY WITH INT(ST_ACT_TOT/BUY_SELL_R)                                                                                                                                                                                                  
         REPL ST_ACT_SEL WITH ST_ACT_TOT-(ST_ACT_BUY*BUY_SELL_R)                                                                                                                                                                                          
      endif                                                                                                                                                                                                                                               
      unlock                                                                                                                                                                                                                                              
      sele 1                                                                                                                                                                                                                                              
      SKIP                                                                                                                                                                                                                                                
   ENDDO                                                                                                                                                                                                                                                  
ENDIF                                                                                                                                                                                                                                                     
@ 48,00 SAY REPL('-',95)                                                                                                                                                                                                                                  
@ 49,07 SAY 'GRAND TOTAL :'                                                                                                                                                                                                                               
@ 49,76 SAY 'RP.'                                                                                                                                                                                                                                         
@ 49,81 SAY TTL1 PICT '99,999,999,999'                                                                                                                                                                                                                    
@ 50,00 SAY REPL('=',95)                                                                                                                                                                                                                                  
@ 51,07 SAY 'NOTE        :'                                                                                                                                                                                                                               
@ 53,00 SAY REPL('=',95)                                                                                                                                                                                                                                  
TTL1=0                                                                                                                                                                                                                                                    
BR=100                                                                                                                                                                                                                                                    
@ 57,03 SAY 'ISSUED BY : ________________'                                                                                                                                                                                                                
@ 57,65 SAY 'RECEIVED BY : ______________'                                                                                                                                                                                                                
@ 58,03 SAY 'NAME :'                                                                                                                                                                                                                                      
@ 58,65 SAY 'NAME :'                                                                                                                                                                                                                                      
@ 59,03 SAY 'DATE :'                                                                                                                                                                                                                                      
@ 59,65 SAY 'DATE :'                                                                                                                                                                                                                                      
EJECT                                                                                                                                                                                                                                                     
@ 0,0 SAY CHR(18) PICT 'X'                                                                                                                                                                                                                                
SET DEVI TO SCREEN                                                                                                                                                                                                                                        
CLOSE DATA                                                                                                                                                                                                                                                
CLOSE INDEX                                                                                                                                                                                                                                               
RETURN                                                                                                                                                                                                                                                    
                                                                                                                                                                                                                                                          
                                                                                                                                                                                                                                                          
                                                                                                                                                                                                                                                          
